home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / system / 4utils84.zip / 4ff.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-08  |  15KB  |  475 lines
  1. PROGRAM FileFind;
  2. {$A+,B-,D-,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X-}
  3. {$M 16384,0,655360}
  4. (* ----------------------------------------------------------------------
  5.    A 4DOS-aware file finder. It searches in various archives too.
  6.  
  7.    (c) 1992, 1994 Copyright by David Frey,
  8.                                Urdorferstrasse 30
  9.                                8952 Schlieren ZH
  10.                                Switzerland
  11.  
  12.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  13.  
  14.    DISCLAIMER:   This program is freeware: you are allowed to use, copy
  15.                  and change it free of charge, but you may not sell or hire
  16.                  4FF. The copyright remains in my hands.
  17.  
  18.                  If you make any (considerable) changes to the source code,
  19.                  please let me know. (send me a copy or a listing).
  20.                  I would like to see what you have done.
  21.  
  22.                  I, David Frey, the author, provide absolutely no warranty of
  23.                  any kind. The user of this software takes the entire risk of
  24.                  damages, failures, data losses or other incidents.
  25.  
  26.    NOTES:        Turbo Pascal 6.0 required for compiling. (sorry, but I'm
  27.                  using FormatStr for output)
  28.  
  29.    ENHANCEMENTS: adapted to 4DOS 4.01 - when redirecting into files,
  30.                  full descriptions will be shown, otherwise the
  31.                  descriptions will be truncated at the right screen margin.
  32.  
  33.                  paging switch (/p) added.
  34.                  Fast screen output when no redirected output has been used.
  35.  
  36.                  Searches for Read Only / Hidden directories, too.
  37.  
  38.                  ARJ File scanning added.
  39.  
  40.                  Supports now 4DOS 5.0, i.e. 200 characters description
  41.                  length.
  42.  
  43.                  Old /d switch renamed to /f. /d stands now for description.
  44.    ----------------------------------------------------------------------- *)
  45.  
  46. USES {$IFOPT G+} Test286, {$ENDIF}
  47.      Fix, Crt, Dos, Objects, Memory, Drivers,
  48.      StringDateHandling, DescriptionHandling, HandleINIFile,
  49.      ScanLZHFiles, ScanZIPFiles, ScanARJFiles, Globals;
  50.  
  51. CONST Header= '4FF 4DOS File Find 1.83 -- (c) David Frey 1992, 1994';
  52.  
  53. VAR   ActDir, StartDir            : STRING;
  54.       FileSpecArray               : FileSpecArrayType;
  55.  
  56.       DescFile                    : TEXT;
  57.       DescLine                    : STRING;
  58.       DescLineNr                  : WORD;
  59.       Desc                        : DescStr;
  60.       DescStart                   : BYTE;
  61.       DescEnd                     : BYTE;
  62.       DescFound                   : BOOLEAN;
  63.  
  64.       i,l                         : WORD;
  65.       k                           : BYTE;
  66.       FileSpecs                   : BYTE;
  67.       ps,fs                       : STRING;
  68.       IORes                       : INTEGER;
  69.  
  70.       Templ                       : STRING;
  71.       FormatTemplate              : STRING;
  72.  
  73.       OldCtrlBreakHandler         : POINTER;
  74.       OldCtrlBreakState           : BOOLEAN;
  75.       BrokeOut                    : BOOLEAN;
  76.  
  77. PROCEDURE MyCtrlBreakHandler; FAR;
  78.  
  79. BEGIN
  80.  ExitProc := OldCtrlBreakHandler; SetCBreak(OldCtrlBreakState);
  81.  {$I-}
  82.  ChDir(ActDir); IORes := IOResult;
  83.  IF BrokeOut THEN
  84.   BEGIN
  85.    WriteLn(Output);
  86.    WriteLn(Output,' EXITING - User broke out of program.');
  87.    WriteLn(Output);
  88.   END;
  89.  Close(Output);
  90.  IF NOT Redirected THEN NormVideo;
  91. END;
  92.  
  93. PROCEDURE ShowFileData(Item: PFileData; VAR Path: PathStr);
  94.  
  95. VAR Index: INTEGER;
  96.     Date : DateStr;
  97.     Time : TimeStr;
  98.  
  99. BEGIN
  100.  IF BareOutput THEN
  101.   WriteLn(Output,Path,'\',Item^.Name)
  102.  ELSE
  103.   BEGIN
  104.    IF FileCount = 0 THEN
  105.     BEGIN
  106.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  107.      WriteLn(Output,Path,'\'); IF DoPage THEN TestForMoreMsg;
  108.     END;
  109.  
  110.    InfoArray[0] := @Item^.Name;
  111.    InfoArray[1] := @Item^.Ext;
  112.    IF Item^.Attr AND Directory = Directory THEN SizeStr := '<DIR>'
  113.    ELSE
  114.     SizeStr := FormattedLongIntStr(Item^.Size,10);
  115.                                                   InfoArray[2] := @SizeStr;
  116.    Date := FormDate(Item^.DateRec);               InfoArray[3] := @Date;
  117.    Time := FormTime(Item^.DateRec);               InfoArray[4] := @Time;
  118.  
  119.    AttrStr := '....';
  120.    IF Item^.Attr AND ReadOnly = ReadOnly THEN AttrStr[1] := 'r';
  121.    IF Item^.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  122.    IF Item^.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  123.    IF Item^.Attr AND Archive  = Archive  THEN AttrStr[4] := 'a';
  124.    InfoArray[5] := @AttrStr;
  125.  
  126.    InfoArray[6] := Item^.Desc;
  127.  
  128.    FormatStr(s,FormatTemplate,InfoArray);
  129.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  130.  
  131.    INC(TotalSize,Item^.Size); INC(DirSize,Item^.Size);
  132.    INC(TotalFileCount); INC(FileCount);
  133.   END;
  134. END; (* ShowFileData *)
  135.  
  136. PROCEDURE BuildList(Dir: DirStr; VAR FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  137.                     Attr: BYTE);
  138. (* The starting point, dir, includes the drive *)
  139.  
  140.  
  141. VAR Search: SearchRec;
  142.     DescFileExists: BOOLEAN;
  143.     DescFileList  : PFileList;
  144.     l,i,k         : BYTE;
  145.  
  146.     PROCEDURE ExamineFile(Item: POINTER); FAR;
  147.     (* Print the file data, if the Attributes match *)
  148.  
  149.     BEGIN
  150.      IF (((searchdesc = '') AND
  151.            (NOT ExactAttr  OR
  152.             (ExactAttr AND (PFileData(Item)^.Attr = Attr)))) OR
  153.         (Pos(searchdesc,PFileData(Item)^.Desc^) > 0)) THEN
  154.       ShowFileData(PFileData(Item),Dir);
  155.     END;
  156.  
  157. BEGIN (* BuildList *)
  158.  FileCount := 0; DirSize := 0;
  159.  Attr := Attr AND NOT Directory AND NOT VolumeId;
  160.  OldLHFileName := ''; OldZipFileName := '';
  161.  
  162.  s := Dir; l := Length(s);
  163.  IF (l>3) AND (s[l] = '\') THEN Delete(s,l,1);
  164.  
  165.  l := Length(Dir); IF (s[l] = '\') THEN Delete(Dir,l,1);
  166.  
  167.  {$I-}
  168.  ChDir(s); IORes := IOResult;
  169.  {$I+}
  170.  
  171.  FOR k := 1 TO FileSpecs DO
  172.   BEGIN
  173.    DescFileList := NIL; DescFileList := New(PFileList,Init(Dir,FileSpec[k],0));
  174.    IF DescFileList = NIL THEN Abort('Unable to allocate DescFileList');
  175.  
  176.    IF (FileList^.Status = ListTooManyFiles) OR
  177.       (FileList^.Status = ListOutofMem) THEN
  178.     BEGIN
  179.      IF FileList^.Status = ListTooManyFiles THEN
  180.       WriteLn('Warning! Too many files in directory, description file will be truncated!')
  181.      ELSE
  182.       WriteLn('Warning! Out of memory, description file will be truncated!');
  183.     END;
  184.  
  185.    IF DescLong THEN
  186.     WriteLn('Warning! Some descriptions are too long; they will be truncated.');
  187.  
  188.    DescFileList^.ForEach(@ExamineFile);
  189.    Dispose(DescFileList,Done);
  190.   END;
  191.  
  192.  IF ScanLZHArchives THEN
  193.   BEGIN
  194.    FindFirst('????????.LZH',ReadOnly+Archive,Search);
  195.    WHILE DosError = 0 DO
  196.     BEGIN
  197.      SearchInLZHFile(FileSpec,FileSpecs,Dir,Search);
  198.      FindNext(Search);
  199.     END;
  200.   END;
  201.  
  202.  IF ScanZIPArchives THEN
  203.   BEGIN
  204.    FindFirst('????????.ZIP',ReadOnly+Archive,Search);
  205.    WHILE DosError = 0 DO
  206.     BEGIN
  207.      SearchInZIPFile(FileSpec,FileSpecs,Dir,Search);
  208.      FindNext(Search);
  209.     END;
  210.   END;
  211.  
  212.  IF ScanARJArchives THEN
  213.   BEGIN
  214.    FindFirst('????????.ARJ',ReadOnly+Archive,Search);
  215.    WHILE DosError = 0 DO
  216.     BEGIN
  217.      SearchInARJFile(FileSpec,FileSpecs,Dir,Search);
  218.      FindNext(Search);
  219.     END;
  220.   END;
  221.  
  222.  IF NOT BareOutput AND (FileCount > 0) THEN
  223.   BEGIN
  224.    Templ := '%-4s entr';
  225.    IF FileCount = 1 THEN Templ := Templ + 'y,  '
  226.                     ELSE Templ := Templ + 'ies,';
  227.    Templ := Templ+' %10s Bytes';
  228.  
  229.    FileStr := FormattedIntStr(FileCount,4);    InfoArray[0] := @FileStr;
  230.    SizeStr := FormattedLongIntStr(DirSize,10); InfoArray[1] := @SizeStr;
  231.    FormatStr(s,Templ,InfoArray);
  232.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  233.   END;
  234.  
  235.  FindFirst('????????.???',Directory+ReadOnly+Hidden+SysFile,Search);
  236.  WHILE DosError = 0 DO
  237.   BEGIN
  238.    IF (Search.Attr AND Directory = Directory) AND
  239.       (Search.Name <> '.') AND (Search.Name <> '..') THEN
  240.     BuildList(Dir+'\'+Search.Name+'\',FileSpec,FileSpecs,Attr);
  241.    FindNext(Search);
  242.   END;
  243.  {$I-}
  244.  ChDir('..'); IORes := IOResult;
  245.  {$I+}
  246. END; (* BuildList *)
  247.  
  248.  
  249. FUNCTION DriveValid(C: CHAR): BOOLEAN; ASSEMBLER;
  250. ASM
  251.   MOV   DL,C
  252.   SUB   DL,'A'-1
  253.   MOV   AH,36H
  254.   Int   21H
  255.   INC   AX
  256.   JE    @@2
  257.   MOV   AL,1
  258. @@2:
  259. END; (* DriveValid *)
  260.  
  261. FUNCTION DiskInDrive(C: CHAR): BOOLEAN; ASSEMBLER;
  262.  
  263. ASM
  264.   PUSH  DS
  265.   MOV   DL,C
  266.   SUB   DL,'A'-1
  267.   MOV   AH,1cH    (* Get Drive Data, AL: Sec/Cluster, FF=drive empty ... *)
  268.   Int   21H
  269.   INC   AX
  270.   JZ   @@1
  271.   MOV  AL,1
  272. @@1:
  273.   POP  DS
  274. END;
  275.  
  276. PROCEDURE GiveHelp;
  277.  
  278. BEGIN
  279.  WriteLn(Output);
  280.  WriteLn(Output,Header);
  281.  WriteLn(Output);
  282.  WriteLn(Output,'This program is freeware: you are allowed to use, copy it free');
  283.  WriteLn(Output,'of charge, but you may not sell or hire 4FF.');
  284.  WriteLn(Output);
  285.  WriteLn(Output,'usage: 4FF [/a:[-]rash][/zx][/s][/b][/ddesc][/f][/m:nn][/?] [start dir\]{filenames}');
  286.  WriteLn(Output);
  287.  WriteLn(Output,' /a:rash search for files with these attributes set.');
  288.  WriteLn(Output,' /zx     archive type x, x is one of the following:');
  289.  WriteLn(Output,'           : all archives');
  290.  WriteLn(Output,'         - : no  archives');
  291.  WriteLn(Output,'         a : add ARJ archives.');
  292.  WriteLn(Output,'         l : add LZH archives.');
  293.  WriteLn(Output,'         z : add ZIP archives.');
  294.  WriteLn(Output,' /s      scan only subdirectories of given path `start-dir''');
  295.  WriteLn(Output,' /b      bare listing (omits size, date, and descriptions)');
  296.  WriteLn(Output,' /ddesc  list files with description desc');
  297.  WriteLn(Output,' /f      scan all drives (floppy drives included)');
  298.  WriteLn(Output,' /m:nn   set right margin to nn');
  299.  WriteLn(Output,' /p      page output');
  300.  WriteLn(Output,' /?      this help display.');
  301.  HALT;
  302. END; (* GiveHelp *)
  303.  
  304. BEGIN
  305.  GetCBreak(OldCtrlBreakState); SetCBreak(FALSE);
  306.  OldCtrlBreakHandler := ExitProc; ExitProc := @MyCtrlBreakHandler;
  307.  BrokeOut := FALSE;
  308.  
  309.  GetDir(0,ActDir);
  310.  
  311.  ps := DownStr(ParamStr(1));
  312.  IF  ps[1] = '/' THEN ps[1]:= '-';
  313.  
  314.  IF (ps = '-?') OR (ps = '-h') THEN GiveHelp;
  315.  
  316.  IF TextRec(Output).Name[0] <> #0 THEN
  317.   BEGIN
  318.    Str(DescLen,DescTempl); DescTempl := '%-'+DescTempl+'s';
  319.   END;
  320.  
  321.  BareOutput      := FALSE; ExactAttr  := FALSE;
  322.  SubDirectories  := FALSE; AllDrives  := FALSE;
  323.  ScanARJArchives := TRUE;  ScanLZHArchives := TRUE; ScanZIPArchives := TRUE;
  324.  FileSpecArray[1]:= '*.*'; FileSpecs := 1; StartDir := ''; searchdesc := '';
  325.  
  326.  FormatTemplate := '%-8s%4s  %10s '+DateTempl+' '+TimeTempl+' %4s '+DescTempl;
  327.  
  328.  i := 1; l := 0; k := 0;
  329.  REPEAT
  330.   ps := ParamStr(i);
  331.   IF ps[1] = '/' THEN ps[1] := '-';
  332.   IF ps[1] = '-' THEN
  333.    BEGIN
  334.     s := Copy(ps,2,255);
  335.  
  336.     (* Case sensitive options: *)
  337.     IF (s[1] = 'd') THEN searchdesc := Copy(s,2,255);
  338.  
  339.     (* Case insensitive options: *)
  340.     DownString(s);
  341.  
  342.     IF NOT SubDirectories    THEN SubDirectories    := (s='s');
  343.     IF NOT BareOutput        THEN BareOutput        := (s='b');
  344.     IF NOT AllDrives         THEN AllDrives         := (s='f');
  345.     IF NOT DoPage AND NOT Redirected THEN DoPage    := (s='p');
  346.  
  347.     IF s[1] = 'a' THEN
  348.      BEGIN
  349.       s := Copy(s,Pos(':',s)+1,255);
  350.       Attr := 0; AttrStr := '....'; ExactAttr := TRUE;
  351.  
  352.       IF (Pos('r',s) > 0) AND (Pos('-r',s) = 0) THEN BEGIN INC(Attr,ReadOnly); AttrStr[1] := 'r'; END;
  353.       IF (Pos('h',s) > 0) AND (Pos('-h',s) = 0) THEN BEGIN INC(Attr,Hidden  ); AttrStr[2] := 'h'; END;
  354.       IF (Pos('s',s) > 0) AND (Pos('-s',s) = 0) THEN BEGIN INC(Attr,SysFile ); AttrStr[3] := 's'; END;
  355.       IF (Pos('a',s) > 0) AND (Pos('-a',s) = 0) THEN BEGIN INC(Attr,Archive ); AttrStr[4] := 'a'; END;
  356.      END;
  357.  
  358.     IF s[1] = 'm' THEN
  359.      BEGIN
  360.       Delete(ps,1,3); Val(ps,k,IORes);
  361.       MaxViewLength := k-31-Length(DateFormat)-Length(TimeFormat);
  362.       Str(MaxViewLength,DescTempl); DescTempl := '%-'+DescTempl+'s';
  363.      END;
  364.  
  365.     IF (s[1] = 'z') AND (Length(s) > 1) THEN
  366.      FOR k := 1 TO Length(s)-1 DO
  367.       IF s[1+k] = '-' THEN
  368.        BEGIN
  369.         ScanARJArchives := FALSE;
  370.         ScanLZHArchives := FALSE;
  371.         ScanZIPArchives := FALSE;
  372.        END
  373.       ELSE
  374.        IF (s[1+k] = 'a') THEN ScanARJArchives := TRUE
  375.        ELSE
  376.         IF (s[1+k] = 'l') THEN ScanLZHArchives := TRUE
  377.         ELSE
  378.          IF (s[1+k] = 'z') THEN ScanZIPArchives := TRUE;
  379.     INC(l);
  380.    END;
  381.    INC(i);
  382.   UNTIL (i>ParamCount) OR (ps[1] <> '-');
  383.  
  384.  StartDir := '';
  385.  IF l < ParamCount THEN
  386.   BEGIN
  387.    FOR i := l+1 TO ParamCount DO
  388.     BEGIN
  389.      FSplit(ParamStr(i),Path,Name,Ext);
  390.      IF (Path <> '') AND (StartDir = '') THEN
  391.        BEGIN StartDir := UpStr(Path); SubDirectories := TRUE; END;
  392.      IF Name = '' THEN Name := '*';
  393.      IF Ext  = '' THEN Ext  := '.*';
  394.  
  395.      FileSpecArray[i-l] := Name+Ext; DownString(FileSpecArray[i-l]);
  396.     END;
  397.     FileSpecs := ParamCount-l;
  398.   END;
  399.  
  400.  IF StartDir = ''      THEN StartDir := ActDir;
  401.  IF NOT SubDirectories THEN StartDir := Copy(StartDir,1,3);
  402.  
  403.  IF NOT BareOutput THEN
  404.   BEGIN
  405.    WriteLn(Output,Header);
  406.    WriteLn(Output);
  407.    WriteLn(Output,'This program is freeware: you are allowed to use,');
  408.    WriteLn(Output,'copy it free of charge, but you may not sell or hire 4FF.');
  409.    WriteLn(Output);
  410.    IF FileSpecs = 1 THEN WriteLn(Output,'Filename  = ',FileSpecArray[1],'.')
  411.    ELSE
  412.     BEGIN
  413.      Write(Output, 'Filenames = ');
  414.      FOR i := 1 TO FileSpecs DO
  415.       BEGIN
  416.        Write(Output,FileSpecArray[i]);
  417.        IF i < FileSpecs THEN Write(Output,', ')
  418.                         ELSE WriteLn(Output,'.');
  419.       END;
  420.     END;
  421.    IF AllDrives THEN WriteLn(Output,'Scanning all drives.')
  422.                 ELSE WriteLn(Output,'Path      = ',StartDir);
  423.  
  424.    IF searchdesc <> '' THEN
  425.      WriteLn(Output,'Searching for descriptions containing the string ''',searchdesc,'''');
  426.  
  427.    Line := 7;
  428.    IF ExactAttr THEN
  429.     BEGIN
  430.      WriteLn(Output,'Attributes= ',AttrStr); INC(Line);
  431.     END;
  432.   END;
  433.  
  434.  IF ScanLZHArchives OR ScanZIPArchives OR ScanARJArchives THEN InstallBuffer;
  435.  IF BareOutput THEN Justify := Left;
  436.  
  437.  TotalFileCount := 0; TotalSize := 0; BrokeOut := TRUE;
  438.  
  439.  IF NOT AllDrives THEN
  440.   BEGIN
  441.    l := Length(StartDir);
  442.    IF (l > 3) AND (StartDir[l] = '\') THEN Delete(StartDir,l,1);
  443.    BuildList(StartDir,FileSpecArray,FileSpecs,Attr)
  444.   END
  445.  ELSE
  446.   FOR Drive := 'A' TO 'Z' DO
  447.     IF DriveValid(Drive) AND DiskInDrive(Drive) THEN
  448.       BuildList(Drive+':\',FileSpecArray,FileSpecs,Attr);
  449.  
  450.  BrokeOut := FALSE;
  451.  
  452.  IF NOT BareOutput THEN
  453.   BEGIN
  454.    IF TotalFileCount = 0 THEN s := 'no files found.'
  455.    ELSE
  456.     BEGIN
  457.      Templ := '%s file';
  458.      IF TotalFileCount = 1 THEN Templ := Templ +', '
  459.                            ELSE Templ := Templ +'s,';
  460.      Templ := Templ+'   %10s Bytes';
  461.  
  462.      FileStr := FormattedIntStr(TotalFileCount,4); InfoArray[0] := @FileStr;
  463.      SizeStr := FormattedLongIntStr(TotalSize,10); InfoArray[1] := @SizeStr;
  464.      FormatStr(s,Templ,InfoArray);
  465.     END;
  466.  
  467.    WriteLn(Output,'------------------------------------------------'); IF DoPage THEN TestForMoreMsg;
  468.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  469.   END;
  470.  
  471.  IF ScanLZHArchives OR ScanZIPArchives OR ScanARJArchives THEN FreeBuffer;
  472.  
  473.  DoneMemory;
  474. END.
  475.